home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / SURFMODL.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-06  |  20KB  |  539 lines
  1. {$I defines.inc }
  2.  
  3. program SURFMODL;
  4. uses
  5. {$IFDEF ANSICRT}
  6.      ansicrt,
  7. {$ELSE}
  8.      crt,
  9. {$ENDIF}
  10.      SURFGRAF;       { Graphics Routines }
  11.  
  12. {$IFDEF USE8087}
  13. type
  14.   REAL = single;
  15. {$ENDIF}
  16.  
  17. const
  18. {$IFDEF USE8087}
  19.    SURFMVSN: STRING[10] = '2.00c 8087';
  20. {$ELSE}
  21.    Surfmvsn: string[5] = '2.00c';           { version number }
  22. {$ENDIF}
  23.    Lastupd: string[20] = '06 February 1988';     { date of last update }
  24.  
  25. { SURFMODL: Surface modeling in three dimensions.
  26.  
  27.   SURFMODL is distributed without any warranty, express or implied.
  28.   In no event shall the authors be liable for any loss of profit or
  29.   any other commercial damage, including but not limited to
  30.   special, incidental, consequential or other damages.
  31.  
  32.   SURFMODL may be freely distributed, or distributed at nominal
  33.   copying/mailing fee, but may not be otherwise charged for.
  34.   It may not be distributed with commercial software without
  35.   express written permission of the principle author:
  36.     Kenneth Van Camp
  37.     P.O. Box 784
  38.     Stroudsburg, PA  18360
  39.  
  40.   HISTORY OF MODIFICATIONS:
  41.     Version 1.0   (February 1987)
  42.     Version 1.1   (March    1987) - Added preliminary support for Borland's
  43.         Turbo Graphix Toolbox, and axes on the plots.
  44.     Version 1.1A  (April    1987) - Added Russell Nelson's updates for
  45.         HZ-100 without Toolbox
  46.     Version 1.2   (May      1987) - Added Russell Nelson's updates for
  47.         EGA without Toolbox. Changed NORMALIZ.PAS to NORMALIZ.PRE and
  48.         added a check for the YREVERSE preprocessor definition. Added
  49.         a check in SURFMODL.PRE for the NO_OVLY preprocessor definition,
  50.         so SURFMODL is not overlaid.
  51.     Version 1.3   (November 1987) - Added Ian Murphy's updates to use
  52.         pointers into the heap for all the major arrays, if BIGMEM is
  53.         defined.  Fixed thick/thin line problem in hidden line removal,
  54.         per Brad Keister.  Allowed Toolbox versions to call windowing
  55.         routines.  Fixed Read New File problem in PARAMENU.  Fixed dithering
  56.         problem in FILLSURF where Pcolor was not defined.  Fixed interpolated
  57.         shading problem in INTRFILL where a surface was allowed to have a
  58.         shade of 0, and Pcolor was not defined.  Fixed Axis-drawing bug.
  59.         Added abort capability during plotting.  Modified all menu reads
  60.         so hitting Enter keeps old value.  Added random shading in Gouraud
  61.         interpolation.  Added "status dots" at bottom of graphics screen.
  62.         Speeded up non-Gouraud surface filling by adding special horizontal
  63.         line-draw routine.  Added supported for the QuadEGA Prosync graphics
  64.         card, as provided by Rainer Kleinrensing.  Added in-line assembly
  65.         code by Klara Schroeder and Jochen Kraemer to support Hercules
  66.         graphics adapter without the Turbo Graphix Toolbox.
  67.     Version 1.31  (December 1987) - Took out in-line assembly code for
  68.         Hercules, and went back to the Toolbox code.  This is the ONLY
  69.         difference between versions 1.3 and 1.31!
  70.     Version 2.00  (January 1988)  - Converted to Turbo Pascal 4.0 by Kevin
  71.         Lowey.  Many minor changes such as having menu ask if you really
  72.         want to quit.  Major changes included use of built in preprocessor
  73.         directives (eliminating the need for mprep) and use of Borland
  74.         Graphics Interface (BGI).  All SURFMODL graphics primitives are now
  75.         in the unit SURFGRAF.PAS.  If non-BGI supported devices are used
  76.         (such as the enclosed DEC VAXmate driver) then the unit SURFBGI is
  77.         included.  This unit emulates the BGI functions used by SURFMODL.
  78.  
  79.         The systems supported have changed.  Support was dropped (for now)
  80.         for the Sanyo and Zenith Z-100 computers, but full support for the
  81.         BGI systems (see Turbo 4 manual)  are supported.  Because of
  82.         these changes the SYSTEM value in the .INI files has been changed.
  83.         This program will read version 3 and earlier .INI files, but creates
  84.         version 4 .INI files.  In addition to storing the graphics system,
  85.         the graphics mode on that system is now also stored, and you can
  86.         select the mode from the parameters menu.
  87.  
  88.         Benefits: Drawings which used to take 1.5 minutes to draw now take
  89.         one minute.  Device independant support for CGA, EGA, VGA, MCGA,
  90.         Hercules Mono, and AT&T computers are provided, and overlays are no
  91.         longer needed.
  92.  
  93.         A minor change to the shading calculation was provided by Steve Enns
  94.         of the University of Saskatchewan.  It eliminates the "normalization"
  95.         of the data points done in the shading calculation.  The end results
  96.         are the same but some floating point operations have been deleted,
  97.         speeding up the program a bit.
  98.  
  99.         A new option, "F" is now available when a completed image is on the
  100.         screen.  Typing "F" will save the current image into a file called
  101.         SURFMODL.PIC.  You can play back sequences of these images with the
  102.         new utility program called PLAYBACK.
  103.  
  104.         IFDEF support for the 8087 chip has been added.
  105.  
  106. }
  107.  
  108.  
  109. {$ifdef BIGMEM}
  110. const MAXNODES = 4096;      { maximum # of nodes in the entire solid }
  111.       MAXCONNECT = 16384;   { maximum # of connections in entire solid }
  112.       MAXSURF = 5461;       { maximum # of surfaces in entire solid }
  113.                             { (MAXSURF = MAXCONNECT / 3) }
  114. {$ELSE}
  115. const MAXNODES = 1024;      { maximum # of nodes in the entire solid }
  116.       MAXCONNECT = 4096;    { maximum # of connections in entire solid }
  117.       MAXSURF = 1365;       { maximum # of surfaces in entire solid }
  118.                             { (MAXSURF = MAXCONNECT / 3) }
  119. {$endif}
  120.       MAXMATL = 30;         { maximum # of materials in entire solid }
  121.       MAXPTS = 600;         { maximum # of line points (in fillsurf) }
  122.       MAXVAR = 20;          { maximum # of numeric inputs on a line }
  123.       MAXLITE = 20;         { maximum # of light sources }
  124.  
  125.  
  126. type  points = array[1..MAXPTS] of integer;
  127.       realpts = array[1..MAXPTS] of real;
  128.       text80 = string[80];
  129.       vartype = array[1..MAXVAR] of real;
  130.       surfaces = array[1..MAXSURF] of real;
  131.       vector = array[1..3] of real;
  132.       nodearray= array[1..MAXNODES] of real;
  133.  
  134. {$ifdef BIGMEM}
  135.   { A note on the BIGMEM definition:  Everything included under this
  136.     section is a trick designed to overcome the memory limitations
  137.     imposed by Turbo Pascal version 3.x and below.  Since TP limits
  138.     all variable storage to one segment (64K), the following pointer
  139.     definitions overcome this by storing the major SURFMODL arrays
  140.     in the heap space.
  141.   }
  142.       heaparray1 = record Xworld:nodearray;
  143.                    end;
  144.       hptr1 = ^heaparray1;
  145.       heaparray2 = record Yworld:nodearray;
  146.                    end;
  147.       hptr2 = ^heaparray2;
  148.       heaparray3 = record Zworld:nodearray;
  149.                    end;
  150.       hptr3 = ^heaparray3;
  151.  
  152.       heaparray4 = record Xtran:nodearray;
  153.                    end;
  154.       hptr4 = ^heaparray4;
  155.       heaparray5 = record Ytran:nodearray;
  156.                    end;
  157.       hptr5 = ^heaparray5;
  158.       heaparray6 = record Ztran:nodearray;
  159.                    end;
  160.       hptr6 = ^heaparray6;
  161.       heaparray7 = record Connect :array[1..MAXCONNECT] of integer;
  162.                    end;
  163.       hptr7 = ^heaparray7;
  164.       heaparray8 = record Nvert : array[1..MAXSURF] of integer;
  165.                    end;
  166.       hptr8 = ^heaparray8;
  167.       heaparray9 = record Matl : array[1..MAXSURF] of integer;
  168.                    end;
  169.       hptr9 = ^heaparray9;
  170.       heaparray10 = record Shades : nodearray;
  171.                    end;
  172.       hptr10 = ^heaparray10;
  173.       heaparray11 = record  Surfmin, Surfmax : surfaces;
  174.                    end;
  175.       hptr11 = ^heaparray11;
  176.       heaparray12 = record Nshades  : array[1..MAXNODES] of integer;
  177.                    end;
  178.       hptr12 = ^heaparray12;
  179.       heaparray13 = record Sshade   : surfaces;
  180.                    end;
  181.       hptr13 = ^heaparray13;
  182. {$endif}
  183.  
  184. {$ifdef BIGMEM}
  185. var   ptra : hptr1;   { Xworld }
  186.       ptrb : hptr2;   { Yworld }
  187.       ptrc : hptr3;   { Zworld }
  188.       ptrd : hptr4;   { Xtran }
  189.       ptre : hptr5;   { Ytran }
  190.       ptrf : hptr6;   { Ztran }
  191.       ptrg : hptr7;   { Connect }
  192.       ptrh : hptr8;   { Nvert }
  193.       ptri : hptr9;   { Matl }
  194.       ptrj : hptr10;  { Shades }
  195.       ptrk : hptr11;  { Surfmin, Surfmax }
  196.       ptrl : hptr12;  { Nshades }
  197.       ptrm : hptr13;  { Sshade }
  198. {$ELSE}
  199. var   Xworld, Yworld, Zworld: nodearray;
  200.         { world coordinates of each node }
  201.       Xtran, Ytran, Ztran: nodearray;
  202.         { transformed coordinates of each node }
  203.       Connect: array[1..MAXCONNECT] of integer;
  204.         { surface connectivity data }
  205.       Nvert: array[1..MAXSURF] of integer;
  206.         { # vertices per surface }
  207.       Matl: array[1..MAXSURF] of integer;
  208.         { material number of each surface }
  209.       { NOTE: The Shades, Surfmin, Surfmax, Nshades and Sshade arrays are
  210.         defined in the individual procedures that require them, to save
  211.         global variable space. }
  212. {$endif}
  213.       R1, R2, R3: array[1..MAXMATL] of real;
  214.         { material reflectivity constants }
  215.       Color: array[1..MAXMATL] of integer;
  216.         { material color number }
  217.       Ambient: array[1..MAXMATL] of real;
  218.         { ambient light intensity for each material }
  219.       Xlite, Ylite, Zlite: array[1..MAXLITE] of real;
  220.         { coords of light sources }
  221.       Intensity: array[1..MAXLITE] of real;
  222.         { light source intensities }
  223.  
  224.       Xeye, Yeye, Zeye: real;              { coords of eye }
  225.       Xfocal, Yfocal, Zfocal: real;        { coords of focal point }
  226.       Maxvert: integer;                    { max # vertices per surface }
  227.       Nsurf: integer;                      { # surfaces }
  228.       Nnodes: integer;                     { # nodes }
  229.       Nlite: integer;                      { # light sources }
  230.       Magnify: real;                       { magnification factor }
  231.       Viewtype: integer;                   { code for viewing type: }
  232.                                            { 0=perspective, 1=XY, 2=XZ, 3=YZ }
  233.       Fileread: boolean;                   { flag first file read }
  234.       Nmatl: integer;                      { number of materials }
  235.       Nsides: integer;                     { #sides of surface used (1 or 2)}
  236.       Interpolate: boolean;                { flag for Gouraud interpolation }
  237.       Epsilon: real;                       { Gouraud interpolation range }
  238.       Shadowing: boolean;                  { flag shadowing option }
  239.       Inifile: text80;                     { name of INI file }
  240.       XYadjust: real;                      { factor for screen width }
  241.       Showaxes: integer;                   { code to show (0) no axes; (1) }
  242.                                            { axis directions; (2) full axes }
  243.       Xaxislen,Yaxislen,Zaxislen: real;    { lengths of axes }
  244.       Axiscolor: integer;                  { color to draw axes }
  245.       Nwindow: integer;                    { # graphics windows on screen }
  246.       Xfotran, Yfotran, Zfotran: real;     { transformed focal point }
  247.       XYmax: real;                         { limits of transformed coords }
  248.       Mxc: integer;                        { suggested value of MAXCONNECT }
  249.       memerr : boolean;                    { True if a memory error occured }
  250. { An important function for decoding the Connect array: }
  251.  
  252.  
  253. function KONNEC (Surf, Vert: integer): integer;
  254. { Decode the Connect array to yield the connection data: Vertex Vert of
  255. surface Surf. This function returns an index to the global Xtran, Ytran,
  256. and Ztran arrays (i.e., a node number) }
  257.  
  258. begin
  259. {$ifdef BIGMEM}
  260. with ptrg^ do
  261. begin
  262. {$endif}
  263.   Konnec := Connect[(Surf-1) * Maxvert + Vert];
  264. {$ifdef BIGMEM}
  265. end; {with}
  266. {$endif}
  267. end; { function KONNEC }
  268.  
  269. { Procedure include files }
  270.  
  271. { Graphics Functions }
  272. {$I colormod.INC}         { COLORMOD }
  273. {$I Dither.INC  }         { Graphics Dithering functions }
  274. {$I OPENWIN.INC }         { procedure BRIGHT, OPENWIN }
  275.  
  276. {$I MENUMSG.INC }         { procedure MENUMSG }
  277.  
  278. { Math routines and number input routines}
  279. {$I ARCCOS.INC  }         { function  ARCCOS }
  280. {$I MINMAX.INC }          { procedure MINMAX }
  281. {$I GETKEY.INC  }         { function  GETKEY }
  282. {$I INREAL.INC }          { procedure INREAL }
  283. {$I GETONE.INC }          { functions GETONEREAL, GETONEINT }
  284.  
  285. { File Handling routines }
  286. {$I READINI.INC }         { procedure READINI }
  287. {$I WRITEINI.INC }        { procedure WRITEINI }
  288. {$I READFILE.INC }        { procedure OPENFILE, READFILE }
  289.  
  290. { startup routines }
  291. {$I INITIAL.INC }         { procedure INITIAL }
  292. {$I TITLESCR.INC }        { procedure TITLESCREEN }
  293.  
  294. { Menuing Functions }
  295. {$I LITEMENU.INC }        { procedure LITEMENU }
  296. {$I PARAMENU.INC }        { procedure PARAMENU }
  297. {$I MENU.INC }            { procedure MENU }
  298.  
  299. {$I PERSPECT.INC }        { procedure SETORG, PERSPECT }
  300. {$I NORMALIZ.INC }        { procedure SETNORMAL, NORMALIZE }
  301. {$I CHECKEY.INC }         { function  CHECKEY }
  302. {$I CONTINUE.INC }        { procedure CONTINUE }
  303. {$I BORDER.INC }          { procedure BORDER }
  304. {$I DRAWAXES.INC }        { procedure DRAWAXES }
  305. {$I WIREFRAM.INC }        { procedure WIREFRAME }
  306. {$I ONSCREEN.INC }        { function  ONSCREEN }
  307. {$I STORLINE.INC }        { procedure STORLINE }
  308. {$I SWAPS.INC }           { procedure SWAPINT, SWAPREAL }
  309. {$I SHELLPTS.INC }        { procedure SHELLPTS, SHELLSHADES }
  310. {$I FILLSURF.INC }        { procedure BADSURF, FILLSURF }
  311. {$I SHELSURF.INC }        { procedure SHELSURF }
  312. {$I SHADING.INC }         { procedure NORMAL, POWER,SETSHADE,SHADING,VISIBLE}
  313. {$I HIDNLINE.INC }        { procedure HIDDENLINE }
  314.  
  315. {$ifndef NOSHADOW}
  316. {$I INLIMITS.INC }        { function  INLIMITS (for shadowing) }
  317. {$I CHEKSURF.INC }        { function  CHEKSURF (for shadowing) }
  318. {$I SHADOWS.INC }         { procedure SHADOWS  (for shadowing) }
  319. {$endif}
  320.  
  321. {$I SURFACE.INC }         { procedure SURFACE }
  322. {$I STORSHAD.INC }        { procedure STORSHADES }
  323. {$I INTRFILL.INC }        { procedure INTRFILL }
  324. {$I GOURAUD.INC }         { procedure GOURAUD }
  325.  
  326. { Local variables for main procedure }
  327. var  Cmmd: integer;       { user command }
  328.      Imemavail: longint;  { initial memory available }
  329.  
  330. begin   { SURFMODL main program }
  331. {$IFDEF DEBUG}
  332.   CheckBreak := true; {enable CONTROL-C checking}
  333. {$ENDIF}
  334.  
  335.   if paramcount <> 2 then {only display if not in "engine" mode}
  336.     titlescreen;
  337.  
  338. {$ifdef BIGMEM}
  339.   Imemavail := Maxavail;
  340.  
  341.   { Calculate what MAXCONNECT, MAXNODES & MAXSURF could have been if
  342.     storage were completely used.  The formula is based on the following:
  343.  
  344.     Array Dim  | #Real Arrays | #Int Arrays | Total # Bytes
  345.     ===========|==============|=============|===============
  346.     MAXNODES   |      7       |      1      | 44 * MAXNODES
  347.     MAXSURF    |      3       |      2      | 22 * MAXSURF
  348.     MAXCONNECT |      0       |      1      | 2 * MAXCONNECT
  349.  
  350.     The rightmost column is calculated by the fact that a real takes up
  351.     6 bytes and an integer takes 2 bytes.  Then, using the recommended
  352.     relationships between the three constants:
  353.       MAXNODES = MAXCONNECT / 4
  354.       MAXSURF  = MAXCONNECT / 3
  355.     we can calculate Mxc, which is the "ideal" value for MAXCONNECT based
  356.     on current memory available.  The 10000 is to reserve room for the
  357.     graphics device driver.
  358.  
  359.       44*(Mxc/4) + 22*(Mxc/3) + 2*Mxc = MaxAvail - 10000
  360.     Solving, we get:
  361.  
  362.       Mxc = (MaxAvail - 10000) * 0.0492
  363.  
  364.     which is the calculated value for the ideal MAXCONNECT.  Alternatively,
  365.     we can say that the currently dimensioned SURFMODL requires
  366.     MAXCONNECT / 0.0674 bytes of free memory after initially
  367.     loading SURFMODL in order to run successfully.
  368.  
  369.     To be safe, I'll use the value 0.0491
  370.  
  371.   }
  372.  
  373.   Mxc := trunc((maxavail - 10000) * 0.0491);
  374.  
  375.   if  (Mxc > 32767.0) then
  376.     Mxc := 32767;
  377.  
  378.  
  379. {$ifdef MEMRPT}
  380.   clrscr;
  381.   writeln ('Initial memory available is ',(MaxAvail):7, ' bytes.');
  382.   writeln ('Based on this:');
  383.   if (Mxc < MAXCONNECT) then
  384.     writeln ('MAXCONNECT must be lowered to ',Mxc)
  385.   else
  386.     writeln ('MAXCONNECT may be raised to ',Mxc);
  387.  
  388.   if (Mxc div 4 < MAXNODES) then
  389.     writeln ('MAXNODES must be lowered to ',Mxc div 4)
  390.   else
  391.     writeln ('MAXNODES may be raised to ', Mxc div 4);
  392.  
  393.   if (Mxc div 3 < MAXSURF) then
  394.     writeln ('MAXSURF must be lowered to ', Mxc div 3)
  395.   else
  396.     writeln ('MAXSURF may be raised to ', Mxc div 3);
  397.  
  398.   writeln;
  399.   write ('Initial calculations indicate you ');
  400.   if maxconnect/0.0491 > MaxAvail - 10000 then
  401.     write ('need')
  402.   else
  403.     write('have');
  404.  
  405.    writeln (' ',abs(MAXCONNECT/0.0491 - (Maxavail - 10000)):7:0,
  406.             ' bytes extra mem.');
  407.    writeln;
  408. {$endif}
  409.    memerr := false;
  410.  
  411.    new (ptra);
  412.    if ptra = nil then
  413.      memerr := true;
  414.  
  415.    new (ptrb);
  416.    if ptrb = nil then
  417.      memerr := true;
  418.  
  419.    new (ptrc);
  420.    if ptrc = nil then
  421.      memerr := true;
  422.  
  423.    new (ptrd);
  424.    if ptrd = nil then
  425.      memerr := true;
  426.  
  427.    new (ptre);
  428.    if ptre = nil then
  429.      memerr := true;
  430.  
  431.    new (ptrf);
  432.    if ptrf = nil then
  433.      memerr := true;
  434.  
  435.    new (ptrg);
  436.    if ptrg = nil then
  437.      memerr := true;
  438.  
  439.    new (ptrh);
  440.    if ptrh = nil then
  441.      memerr := true;
  442.  
  443.    new (ptri);
  444.    if ptri = nil then
  445.      memerr := true;
  446.  
  447.    new (ptrj);
  448.    if ptrj = nil then
  449.      memerr := true;
  450.  
  451.    new (ptrk);
  452.    if ptrk = nil then
  453.      memerr := true;
  454.  
  455.    new (ptrl);
  456.    if ptrl = nil then
  457.      memerr := true;
  458.  
  459.    new (ptrm);
  460.    if ptrm = nil then
  461.      memerr := true;
  462.  
  463.  
  464. {$ifdef MEMRPT}
  465.    writeln ('After heap allocations:');
  466.    writeln ('Extra memory available is ',(Maxavail-10000):7, ' bytes.');
  467.    writeln ('Actual memory usage was a factor of ',
  468.             ((Imemavail - (Maxavail - 10000)) / (MAXCONNECT / 0.0491)):5:2,
  469.             ' larger than calculated.');
  470.    writeln;
  471.    writeln ('Press any key to continue');
  472.    repeat until keypressed;
  473.    while keypressed do
  474.      if readkey = ' ' then; {flush keyboard}
  475.  
  476. {$endif} {MEMRPT}
  477.  
  478.    if memerr then begin
  479.      writeln ('You have run out of memory, you must do one of:');
  480.      writeln ('  -- Increase your available memory');
  481.      writeln ('  -- Decrease the array dimensions in SURFMODL and recompile');
  482.      writeln ('  -- Run the smaller version of SURFMODL.');
  483.      writeln;
  484.      halt(1);
  485.    end;
  486. {$endif} {BIGMEM}
  487.  
  488.   {Initialize variables}
  489.   Cmmd := 1;
  490.   initial;
  491.  
  492.   if paramcount < 2 then begin
  493.     repeat
  494.       Cmmd := 2;
  495.       menu (Cmmd);
  496.       if (Cmmd > 1) and (Cmmd < 5) and (not Fileread) then begin
  497.         writeln ('Please proceed to parameter menu to read data file');
  498.         write ('Press any key to continue...');
  499.         while (not keypressed) do;
  500.         Cmmd := 1;
  501.       end;
  502.  
  503.       case Cmmd of
  504.         1: paramenu;
  505.         2: wireframe;
  506.         3: hiddenline;
  507.         4: if (Interpolate) then
  508.              gouraud
  509.            else
  510.              surface;
  511.       end;
  512.     until (Cmmd = 0) or (paramcount = 3);
  513.   end
  514.   else if paramstr(2) = '2' then
  515.     wireframe
  516.   else if paramstr(2) = '3' then
  517.     hiddenline
  518.   else if paramstr(2) = '4' then
  519.     if interpolate then
  520.       gouraud
  521.     else
  522.       surface
  523.   else begin
  524.     clrscr;
  525.     writeln ('Option "',paramstr(2),'" is not recognised.');
  526.     writeln ('Use a number between 2 and 4');
  527.     writeln ('Program halted');
  528.     halt(1);
  529.   end;
  530.  
  531.   window (1,1,80,25);
  532.   clrscr;
  533. {$ifdef MEMRPT}
  534.   writeln;
  535.   writeln ('The smallest amount of free memory during your run was ',
  536.     (Maxavail):7, ' bytes.');
  537. {$endif}
  538. end. { program SURFMODL }
  539.